unit D7zUtils;

interface

uses
  SysUtils, Classes, Sevenzip;

type
  TD7zFileType = (dftZip, dftBZ2, dftRar, dftArj, dftZ, dftLzh, dft7z, dftCab, dftNsis, dftLzma,
    dftPe, dftElf, dftMacho, dftUdf, dftXar, dftMub, dftHfs, dftDmg, dftCompound,
    dftWim, dftIso, dftBkf, dftChm, dftSplit, dftRpm, dftDeb, dftCpio, dftTar,
    dftGZip);
  TD7zFileTypes = set of TD7zFileType;

  TD7zipStrings = TStrings;
  TD7zipStringList = class(TStringList)
  public
    constructor Create();virtual;
  end;

  TOnPassword = procedure (Sender: TObject; var sPassword: WideString; var bContinue:Boolean) of object;
  TOnProgress = procedure (Sender: TObject; bIsTotal: boolean; iValue: Int64; var bContinue:Boolean) of object;

  TD7zipFile = class
  private
    FInArchive: I7zInArchive;
    FItems: TD7zipStrings;
    FTmpStream: TStream;
  private
    FCurrentItemPath: WideString;
    FOnPassword: TOnPassword;
    FOnProgress: TOnProgress;
  private
    FPasswordCallback: T7zPasswordCallback;
    FProgressCallback: T7zProgressCallback;
    function DoOnPassword(var sPassword: WideString): HRESULT;
    function DoOnProgress(bIsTotal: boolean; iValue: Int64): HRESULT;
  public
    constructor Create();virtual;
    destructor Destroy;override;
    function LoadFromFile(AFileName: WideString):Boolean;
    function LoadFromStream(AStream: TStream; AFileTypes: TD7zFileTypes=[]):Boolean;overload;
    function LoadFromStream(AStream: TStream; AFileType: TD7zFileType):Boolean;overload;
  public
    function GetItems(sPath: WideString; iFilter: Integer=0): TD7zipStrings;//iFilter： 0-All 1-File 2 Dir ;  sPath-暂不支持通配符
  public
    function ExtractItemToStream(sFileName: WideString; AStream: TStream):Boolean; //解压/获取单个文件
    function ExtractItemToFile(sFileName: WideString; sToFile: WideString):Boolean;//解压/获取单个文件
  public
    property CurrentItemPath: WideString read FCurrentItemPath;
  public
    //fileSystem functions
    function FileExists(sFileName: WideString):Boolean;
    function DirectoryExists(sDirName: WideString):Boolean;
    function GetCurrentDir(): WideString;
  public
    property OnPassword: TOnPassword read FOnPassword write FOnPassword;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;
  end;

implementation

function FUNC_PasswordCallback(sender: Pointer; var password: UnicodeString): HRESULT; stdcall;
begin
  // call a dialog box ...
  //password := 'password';
  //Result := S_OK;
  Result := S_FALSE;
  if sender=nil then Exit;
  Result := TD7zipFile(sender).DoOnPassword(password);
end;

function FUNC_ProgressCallback(sender: Pointer; total: boolean; value: Int64): HRESULT; stdcall;
begin
  Result := S_FALSE;
  if sender=nil then Exit;
  Result := TD7zipFile(sender).DoOnProgress(total, value);
end;

{ TD7zipFile }

constructor TD7zipFile.Create;
begin
  FItems:=TD7zipStringList.Create;
  FPasswordCallback := @FUNC_PasswordCallback;
  FProgressCallback := @FUNC_ProgressCallback;
end;

destructor TD7zipFile.Destroy;
begin
  FItems.Free;
  FreeAndNil(FTmpStream);
  inherited;
end;

function TD7zipFile.DirectoryExists(sDirName: WideString): Boolean;
var
  iIndex:Integer;
begin
  Result := False;
  if FInArchive=nil then Exit;
  if sDirName<>'' then
  if sDirName[Length(sDirName)]<>'\' then
  sDirName := sDirName +'\';
  iIndex := Self.FItems.IndexOf(sDirName);
  if iIndex=-1 then Exit;
  Result := FInArchive.ItemIsFolder[iIndex];
end;

function TD7zipFile.DoOnPassword(var sPassword: WideString): HRESULT;
var
  bContinue: Boolean;
begin
  bContinue := True;
  if Assigned(FOnPassword) then FOnPassword(Self, sPassword, bContinue);
  if bContinue then Result := S_OK else Result := S_FALSE;
end;

function TD7zipFile.DoOnProgress(bIsTotal: boolean;
  iValue: Int64): HRESULT;
var
  bContinue: Boolean;
begin
  bContinue := True;
  if Assigned(FOnProgress) then FOnProgress(Self, bIsTotal, iValue, bContinue);
  if bContinue then Result := S_OK else Result := S_FALSE;
end;

function TD7zipFile.ExtractItemToFile(sFileName: WideString;
  sToFile: WideString): Boolean;
var
  AStream: TStream;
begin
  AStream:=TFileStream.Create(sToFile, fmCreate);
  try
    Result := ExtractItemToStream(sFileName, AStream);
  finally
    AStream.Free;
  end;
end;

function TD7zipFile.ExtractItemToStream(sFileName: WideString;
  AStream: TStream): Boolean;
var
  iIndex: Integer;
begin
  Result := False;
  if FInArchive=nil then Exit;
  iIndex := FItems.IndexOf(sFileName);
  if iIndex=-1 then Exit;
  try
    FInArchive.ExtractItem(iIndex, AStream, False);
    Result := True;
  except
  end;
end;

function TD7zipFile.FileExists(sFileName: WideString): Boolean;
var
  iIndex:Integer;
begin
  Result := False;
  if FInArchive=nil then Exit;
  if sFileName<>'' then
  if sFileName[Length(sFileName)]<>'\' then
  sFileName := sFileName +'\';
  iIndex := Self.FItems.IndexOf(sFileName);
  if iIndex=-1 then Exit;
  Result := not FInArchive.ItemIsFolder[iIndex];
end;

function TD7zipFile.GetCurrentDir: WideString;
begin
  Result := FCurrentItemPath;
end;

function TD7zipFile.GetItems(sPath: WideString; iFilter: Integer=0): TD7zipStrings;
  function IsItemChild(sParent, sChild: WideString):Boolean;
  //var
  //  sTmp: WideString;
  begin
    if (sParent='') then //获取全部
      Result := True
    else if (sParent='\\') then //根目录
      Result := Pos('\', sChild)=0
    else
    begin
      Result := (Pos(sParent, sChild)=1) and
                (Pos('\', Copy(sChild, Length(sParent)+1, Length(sChild)))=0);
    end;
  end;
var
  I: Integer;
  sTmp: WideString;
  bDir: Boolean;
begin
  Result := TD7zipStringList.Create;
  if (sPath='.') then //当前目录
  begin
    sPath := FCurrentItemPath;
  end
  else if (sPath='..') then //上一层目录
  begin
    if (FCurrentItemPath='') then FCurrentItemPath := '\\';
    if FCurrentItemPath<>'\\' then
    begin
      sPath := FCurrentItemPath;
      if sPath[Length(sPath)]='\' then
      sPath := Copy(sPath, 1, Length(sPath)-1);
      sPath := ExtractFilePath(sPath);
    end
    else
      sPath := FCurrentItemPath;
    if (sPath='') then sPath := '\\';
  end;
  if sPath<>'' then
  begin
    if sPath[Length(sPath)]<>'\' then sPath := sPath +'\';
    FCurrentItemPath := sPath;
  end;
  if (sPath<>'') and (sPath<>'\\') then
  begin
    Result.Add('.');
    Result.Add('..');
  end;
  for I:=0 to FItems.Count-1 do
  begin
    bDir := False;
    sTmp := FItems.Strings[I];
    if sTmp<>'' then
    if sTmp[Length(sTmp)]='\' then
    begin
      sTmp := Copy(sTmp, 1, Length(sTmp)-1);
      bDir := True;
    end;
    if not IsItemChild(sPath, sTmp) then Continue;
    if (iFilter=0)
       or ((iFilter=1) and (not bDir))
       or ((iFilter=2) and (bDir)) then
      Result.Add(sTmp);
  end;
end;

function TD7zipFile.LoadFromFile(AFileName: WideString): Boolean;
  function FileExtToFileTypes(sExt: WideString): TD7zFileTypes;
  begin
    Result := [];
    if (sExt='.ZIP') or (sExt='.JAR') or (sExt='.XPI') then
      Include(Result, dftZip)
    else if (sExt='.BZ2') or (sExt='.BZIP2') or (sExt='.TBZ2') or (sExt='.TBZ') then
      Include(Result, dftBZ2)
    else if (sExt='.RAR') or (sExt='.R00') then
      Include(Result, dftRar)
    else if (sExt='.ARJ') then
      Include(Result, dftArj)
    else if (sExt='.Z') or (sExt='.TAZ') then
      Include(Result, dftZ)
    else if (sExt='.LZH') or (sExt='.LHA') then
      Include(Result, dftLzh)
    else if (sExt='.7Z') then
      Include(Result, dft7z)
    else if (sExt='.CAB') then
      Include(Result, dftCab)
    else if (sExt='.NSIS') then
      Include(Result, dftNsis) //安装包工具
    else if (sExt='.LZMA') or (sExt='.LZMA86') then
      Include(Result, dftLzma)
    else if (sExt='.EXE') then
    begin
      Include(Result, dftPe);
      Include(Result, dftNsis);
    end
    else if (sExt='.PE') or (sExt='.DLL') or (sExt='.SYS') then
      Include(Result, dftPe)
    else if (sExt='.ELF') then
      Include(Result, dftElf)
    else if (sExt='.MACHO') then
      Include(Result, dftMacho)
    else if (sExt='.UDF') then
      Include(Result, dftUdf)
    else if (sExt='.XAR') then
      Include(Result, dftXar)
    else if (sExt='.MUB') then
      Include(Result, dftMub)
    else if (sExt='.HFS') or (sExt='.CD') then
      Include(Result, dftHfs)
    else if (sExt='.DMG') then
      Include(Result, dftDmg)
    else if (sExt='.MSI') or (sExt='.DOC') or (sExt='.XLS') or (sExt='.PPT') then
      Include(Result, dftCompound)
    else if (sExt='.WIM') or (sExt='.SWM') then
      Include(Result, dftWim)
    else if (sExt='.ISO') then
    begin
      Include(Result, dftIso);
      Include(Result, dftUdf);
    end
    else if (sExt='.BKF') then
      Include(Result, dftBkf)
    else if (sExt='.CHM') or (sExt='.CHI') or (sExt='.CHQ') or (sExt='.CHW')
            or (sExt='.HXS') or (sExt='.HXI') or (sExt='.HXR') or (sExt='.HXQ')
            or (sExt='.HXW') or (sExt='.LIT') then
      Include(Result, dftChm)
    else if  (sExt='.001') then
      Include(Result, dftSplit)
    else if  (sExt='.RPM') then
      Include(Result, dftRpm)
    else if  (sExt='.DEB') then
      Include(Result, dftDeb)
    else if  (sExt='.CPIO') then
      Include(Result, dftCpio)
    else if  (sExt='.TAR') then
      Include(Result, dftTar)
    else if  (sExt='.GZ') or (sExt='.GZIP') or (sExt='.TGZ') or (sExt='.TPZ') then
      Include(Result, dftGZip);
  end;
begin
  Result := False;
  FreeAndNil(FTmpStream);
  FTmpStream:=TFileStream.Create(AFileName, fmOpenRead);
  try
    Result := LoadFromStream(FTmpStream, FileExtToFileTypes(UpperCase(ExtractFileExt(AFileName))));
  finally
    if not Result then FreeAndNil(FTmpStream);
  end;
end;

function TD7zipFile.LoadFromStream(AStream: TStream; AFileTypes: TD7zFileTypes=[]): Boolean;
var
  bUnknowType:Boolean;
  AFileType: TD7zFileType;
begin
  FInArchive := nil;
  Result := False;
  try
    bUnknowType := AFileTypes=[];
    AFileType := Low(TD7zFileType);
    while AFileType<High(TD7zFileType) do
    begin
      if (not Result) and (bUnknowType or (AFileType in AFileTypes)) then
        Result := LoadFromStream(AStream, AFileType);
      if Result then Break;
      Inc(AFileType);
    end;
    (*
    if (not Result) and (bUnknowType or (dftZip in AFileTypes)) then
      Result := LoadFromStream(AStream, dftZip);
    if (not Result) and (bUnknowType or (dftBZ2 in AFileTypes)) then
      Result := LoadFromStream(AStream, dftBZ2);
    if (not Result) and (bUnknowType or (dftRar in AFileTypes)) then
      Result := LoadFromStream(AStream, dftRar);
    if (not Result) and (bUnknowType or (dftArj in AFileTypes)) then
      Result := LoadFromStream(AStream, dftArj);
    if (not Result) and (bUnknowType or (dftZ in AFileTypes)) then
      Result := LoadFromStream(AStream, dftZ);
    if (not Result) and (bUnknowType or (dftLzh in AFileTypes)) then
      Result := LoadFromStream(AStream, dftLzh);
    if (not Result) and (bUnknowType or (dft7z in AFileTypes)) then
      Result := LoadFromStream(AStream, dft7z);
    if (not Result) and (bUnknowType or (dftCab in AFileTypes)) then
      Result := LoadFromStream(AStream, dftCab);
    if (not Result) and (bUnknowType or (dftNsis in AFileTypes)) then
      Result := LoadFromStream(AStream, dftNsis);
    if (not Result) and (bUnknowType or (dftLzma in AFileTypes)) then
      Result := LoadFromStream(AStream, dftLzma);
    if (not Result) and (bUnknowType or (dftPe in AFileTypes)) then
      Result := LoadFromStream(AStream, dftPe);
    if (not Result) and (bUnknowType or (dftElf in AFileTypes)) then
      Result := LoadFromStream(AStream, dftElf);
    if (not Result) and (bUnknowType or (dftMacho in AFileTypes)) then
      Result := LoadFromStream(AStream, dftMacho);
    if (not Result) and (bUnknowType or (dftUdf in AFileTypes)) then
      Result := LoadFromStream(AStream, dftUdf);
    if (not Result) and (bUnknowType or (dftXar in AFileTypes)) then
      Result := LoadFromStream(AStream, dftXar);
    if (not Result) and (bUnknowType or (dftMub in AFileTypes)) then
      Result := LoadFromStream(AStream, dftMub);
    if (not Result) and (bUnknowType or (dftHfs in AFileTypes)) then
      Result := LoadFromStream(AStream, dftHfs);
    if (not Result) and (bUnknowType or (dftDmg in AFileTypes)) then
      Result := LoadFromStream(AStream, dftDmg);
    if (not Result) and (bUnknowType or (dftCompound in AFileTypes)) then
      Result := LoadFromStream(AStream, dftCompound);
    if (not Result) and (bUnknowType or (dftWim in AFileTypes)) then
      Result := LoadFromStream(AStream, dftWim);
    if (not Result) and (bUnknowType or (dftIso in AFileTypes)) then
      Result := LoadFromStream(AStream, dftIso);
    if (not Result) and (bUnknowType or (dftBkf in AFileTypes)) then
      Result := LoadFromStream(AStream, dftBkf);
    if (not Result) and (bUnknowType or (dftChm in AFileTypes)) then
      Result := LoadFromStream(AStream, dftChm);
    if (not Result) and (bUnknowType or (dftSplit in AFileTypes)) then
      Result := LoadFromStream(AStream, dftSplit);
    if (not Result) and (bUnknowType or (dftRpm in AFileTypes)) then
      Result := LoadFromStream(AStream, dftRpm);
    if (not Result) and (bUnknowType or (dftDeb in AFileTypes)) then
      Result := LoadFromStream(AStream, dftDeb);
    if (not Result) and (bUnknowType or (dftCpio in AFileTypes)) then
      Result := LoadFromStream(AStream, dftCpio);
    if (not Result) and (bUnknowType or (dftTar in AFileTypes)) then
      Result := LoadFromStream(AStream, dftTar);
    if (not Result) and (bUnknowType or (dftGZip in AFileTypes)) then
      Result := LoadFromStream(AStream, dftGZip);
    *)
  except
    FInArchive := nil;
  end;
end;

function TD7zipFile.LoadFromStream(AStream: TStream;
  AFileType: TD7zFileType): Boolean;
var
  iIndex, I: Integer;
  zStream: IInStream;//T7zStream;
  sTmp, sTmpDir: WideString;
  iPos: Int64;
  sTmpDirListAdd, sTmpDirList: TD7zipStrings;
begin
  Result := False;
  FInArchive := nil;
  FCurrentItemPath := '\\';
  FItems.Clear;
  iPos := AStream.Position;
  case AFileType of
    dftZip   : FInArchive:= CreateInArchive(CLSID_CFormatZip);
    dftBZ2   : FInArchive:= CreateInArchive(CLSID_CFormatBZ2);
    dftRar   : FInArchive:= CreateInArchive(CLSID_CFormatRar);
    dftArj   : FInArchive:= CreateInArchive(CLSID_CFormatArj);
    dftZ     : FInArchive:= CreateInArchive(CLSID_CFormatZ);
    dftLzh   : FInArchive:= CreateInArchive(CLSID_CFormatLzh);
    dft7z    : FInArchive:= CreateInArchive(CLSID_CFormat7z);
    dftCab   : FInArchive:= CreateInArchive(CLSID_CFormatCab);
    dftNsis  : FInArchive:= CreateInArchive(CLSID_CFormatNsis);
    dftLzma  : FInArchive:= CreateInArchive(CLSID_CFormatLzma);
    dftPe    : FInArchive:= CreateInArchive(CLSID_CFormatPe);
    dftElf   : FInArchive:= CreateInArchive(CLSID_CFormatElf);
    dftMacho : FInArchive:= CreateInArchive(CLSID_CFormatMacho);
    dftUdf   : FInArchive:= CreateInArchive(CLSID_CFormatUdf);
    dftXar   : FInArchive:= CreateInArchive(CLSID_CFormatXar);
    dftMub   : FInArchive:= CreateInArchive(CLSID_CFormatMub);
    dftHfs   : FInArchive:= CreateInArchive(CLSID_CFormatHfs);
    dftDmg   : FInArchive:= CreateInArchive(CLSID_CFormatDmg);
    dftCompound : FInArchive:= CreateInArchive(CLSID_CFormatCompound);
    dftWim   : FInArchive:= CreateInArchive(CLSID_CFormatWim);
    dftIso   : FInArchive:= CreateInArchive(CLSID_CFormatIso);
    dftBkf   : FInArchive:= CreateInArchive(CLSID_CFormatBkf);
    dftChm   : FInArchive:= CreateInArchive(CLSID_CFormatChm);
    dftSplit : FInArchive:= CreateInArchive(CLSID_CFormatSplit);
    dftRpm   : FInArchive:= CreateInArchive(CLSID_CFormatRpm);
    dftDeb   : FInArchive:= CreateInArchive(CLSID_CFormatDeb);
    dftCpio  : FInArchive:= CreateInArchive(CLSID_CFormatCpio);
    dftTar   : FInArchive:= CreateInArchive(CLSID_CFormatTar);
    dftGZip  : FInArchive:= CreateInArchive(CLSID_CFormatGZip);
    else
      Exit;
  end;

  zStream := T7zStream.Create(AStream);
  try
    FInArchive.OpenStream(zStream);
    FInArchive.SetPasswordCallback(Self, FPasswordCallback);
    FInArchive.SetProgressCallback(Self, FProgressCallback);
    sTmpDirListAdd := TD7zipStringList.Create;
    sTmpDirList := TD7zipStringList.Create;
    try
      for I:=0 to FInArchive.NumberOfItems-1 do
      begin
        sTmp := FInArchive.ItemPath[I];
        if FInArchive.ItemIsFolder[I] then
        begin
          if (sTmp<>'') and (sTmp[Length(sTmp)]<>'\') then
            sTmp := sTmp+'\';
          if sTmpDirList.IndexOf(sTmp)=-1 then
            sTmpDirList.Add(sTmp);
          //else //已添加到临时列表则需要删除
          begin
            iIndex := sTmpDirListAdd.IndexOf(sTmp);
            if iIndex>-1 then
            sTmpDirListAdd.Delete(iIndex);
          end;
        end
        else
        begin
          sTmpDir := ExtractFilePath(sTmp);
          if sTmpDirList.IndexOf(sTmpDir)=-1 then
          begin //未添加的文件夹需要添加到临时列表里
            if sTmpDirListAdd.IndexOf(sTmpDir)=-1 then
            sTmpDirListAdd.Add(sTmpDir);
          end;
        end;
        FItems.Add(sTmp);
      end;
      FItems.AddStrings(sTmpDirListAdd);
    finally
      sTmpDirList.Free;
      sTmpDirListAdd.Free;
      zStream := nil;
    end;
    Result := True;
  except
    zStream := nil;
    FInArchive := nil;
    AStream.Position := iPos;
  end;
end;

{ TD7zipStringList }

constructor TD7zipStringList.Create;
begin
  Self.CaseSensitive := False;//忽略大小写
end;

end.
